SEMI	LDA #';          ;OUTPUT A ';'
;WRITE A CHR TO OUTPUT DEVICE (SET ON OUTFLG)
OUTALL	PHA
	LDA OUTFLG
;TAPE BY BLOCKS
	CMP #'T          ;TAPES ?
	BNE OUTA1
	PLA
	JMP TOBYTE       ;OUTPUT ONE CHAR TO TAPE BUFFER
;TAPE KIM FORMAT
OUTA1	CMP #'K          ;KIM-1 ?
	BNE OUTA2
	PLA
	JMP OUTTAP
;PRINTER
OUTA2	CMP #'P          ;PRINTER ?
	BNE OUTA3
	SEC              ;TURN PRINTR ON
	ROR PRIFLG
	PLA
	PHP
	JSR OUTPRI
	PLP
	ROL PRIFLG       ;RESTORE FLG
	RTS
;USER DEFINED
OUTA3	CMP #'U          ;USER ROUTINE?
	BNE OUTA4
	SEC              ;SET FLG FOR NORMAL OUTPUT
	JMP (UOUT)       ;YES
;NOWHERE OR TO TTY ,D/P
OUTA4	CMP #'X          ;EAT IT?
	BNE OUT1         ;OUTPUT TO TTY OR D/P
	PLA
	RTS

;THIS ROUTINE OUPTUTS A CRLF TO ANY OUTPUT DEV
;LF AND NULL IS SENT ONLY TO TTY
CRLF	LDA #CR
	JSR OUTALL
	JSR TTYTST       ;TTY OR KB ?
	BNE CR2J
	LDA OUTFLG       ;LF ONLY TO TTY
	CMP #'T
	BEQ CR2J
	CMP #'K
	BEQ CR2J
	CMP #'P
	BEQ CR2J
	LDA #LF
	JSR OUTALL
	LDA #NULLC
	JMP OUTALL

;CRLF TO TERMINAL (TTY OR D/P) ONLY
CRLOW	PHA              ;SAVE A
	LDA OUTFLG
	PHA
	JSR OUTLOW
	JSR CRLF
	PLA
	STA OUTFLG
	PLA
CR2J	RTS

;OUTPUT (CR) TO TTY IF SWITHC ON TTY & INFLG NOT L
;DONT CLR DISPLAY BUT CLEARS PNTRS FOR NEXT LINE
;IF PRNTR HAS PRINTED ON 21RST CHR DONT OUTPUT (CR)
CRCK	LDA INFLG        ;NO (CR) IF 'L'
	CMP #'L
	BNE CRCK1
	RTS
CRCK1	JSR TTYTST       ;CHECK IF TTY OR KB
	BEQ CRLOW        ;BRANCH IF TTY
;IF PRINTR PTR=0 ,DO NOT CLR PRI
	LDA CURPOS
	BEQ CRCK2        ;IF PTR=0 ,NO (CR)
	LDA #CR
	JSR OUTPRI
CRCK2	LDA #$8D         ;(CR) ONLY FOR TV
	JMP OUTDP1
	NOP
	NOP

;WRITE A THEN X IN ASCII TO THE OUTPUT DEV
WRAX	JSR NUMA
	TXA

;PRINT ONE BYTE=TWO ASCII CHARS TO OUTPUT DEVICE
NUMA	PHA
	LSR A
	LSR A
	LSR A
	LSR A
	JSR NOUT
	PLA
	AND #$F
NOUT	CLC
	ADC #$30
	CMP #$3A
	BCC LT10
	ADC #6           ;CARRY IS SET
LT10	JMP OUTALL

;READ TWO CHR & PACK THEM INTO ONE BYTE
;PART OF ALTER MEMORY , / COMM
RD2	JSR REDOUT
	CMP #$D          ;(CR)?
	BEQ RSPAC
	CMP #'           ;FOR MEMORY ALTER
	BEQ RSPAC
	CMP #'.          ;TREAT '.' AS (SPACE)
	BNE RD1
	LDA #$20
	BNE RSPAC
RD1	JSR PACK
	BCS RSPAC
	JSR REDOUT
	JMP PACK
;WAS SPACE OR (CR)
RSPAC	SEC
	RTS

;CONVERT ACC IN ASCII TO ACC IN HEX (4 MSB=0)
HEX	PHA              ;SAVE A
	LDA #0           ;CLEAR STIY IF HEX
	STA STIY+2       ;BECAUSE ONLY ONCE
	PLA
;PACK TWO ASCII INTO ONE HEX (CALL SUBR TWO TIMES)
;RESULT IS GIVEN ON ACC WITH FIRST CHR INTO 4 MSB
PACK	CMP #$30         ;< 30 ?
	BCC RSPAC
	CMP #$47         ; > 47 ?
	BCS RSPAC
	CMP #$3A         ; < #10
	BCC PAK1
	CMP #$40         ; > #10 ?
	BCC RSPAC
	ADC #8           ;ADD 0 IS LETTER (C IS SET)
PAK1	ROL A            ;SHIFT A 4 TIMES
	ROL A
	ROL A
	ROL A
	STX CPIY+3       ;SAVE X
	LDX #4
PAK2	ROL A            ;TRANSFER A TO STIY
	ROL STIY+2       ; THRU CARRY
	DEX
	BNE PAK2
	LDX CPIY+3       ;REST X
	LDA STIY+2
	CLC
	RTS

;GET FOUR BYTE ADDR ,TAKE LAST FOUR CHR TO....
;CALCULATE ADDR  ALLOW DELETE ALSO
ADDIN	JSR EQUAL
ADDNE	LDA CURPO2       ;SAVE POSITION
	PHA
	LDY #0
ADDN1	JSR RDRUB
	CMP #CR
	BEQ ADDN2
	CMP #' 
	BEQ ADDN2
	INY
	CPY #11          ;ALLOW 10
	BCC ADDN1
ADDN2	PLA
	STA CPIY+3       ;SAVE
	CPY #0           ;IF FIRST CHR PUT DEFAULT VALUES
	BNE ADDN3
	LDA #$02
	STA ADDR+1       ;DEFAULT OF 0200
	STA CKSUM        ;DEFAULT
	STY ADDR
	CLC
	RTS
ADDN3	LDX #0
	DEY              ;Y-4
	DEY
	DEY
	DEY
	BPL ADDN5        ;BRANCH IF > 4 CHR
	TYA
	EOR #$FF
	TAY              ;# OF LEADING 0
ADDN4	LDA #$30
	STA ADDR,X
	INX
	DEY
	BPL ADDN4
	LDY CPIY+3       ;NOW THE CHR
	JMP ADDN6
ADDN5	TYA              ;PUT CHR
	CLC
	ADC CPIY+3
	TAY
ADDN6	LDA DIBUFF,Y     ;FROM DISP BUFF
	STA ADDR,X
	INY
	INX
	CPX #4
	BNE ADDN6
	LDX #1
	LDY #0           ;CNVRT CHR TO HEX
ADDN7	LDA ADDR,Y
	JSR HEX
	BCS ADDN8
	INY
	LDA ADDR,Y
	INY
	JSR PACK         ;PACK TWO CHRS INTO 1 BYTE
	BCS ADDN8        ;BRCNH IF ERROR
	STA ADDR,X
	DEX
	BPL ADDN7
	INX              ;X=0
	STX CKSUM        ;TO INDICATE WE GOT AN ADDR
	CLC              ;NO INVALID CHARS
	RTS
ADDN8	JSR CKERO0       ;OUTPUT ERROR MSG
	JSR CRCK         ;(CR)
	SEC              ;SET CARYY FOR INVALID CHR
	RTS

;MEMORY FAIL TO WRITE MSG & SPECIFIC ADDRESS
MEMERR	JSR CRCK
	JSR NXTADD       ;ADD Y TO ADDR+1,ADDR
	LDY #M11-M1      ;PRINT 'MEM FAIL'
	JSR KEP          ;FAIL MSG
	JSR WRITAZ       ;PRINT ADDR+1 , ADDR
	JMP COMIN

;CLEAR DISPLAY & PRINTER POINTERS
CLR	LDA #0
	STA CURPO2       ;DISP PNTR
	STA CURPOS       ;PRINTR PNTR
	RTS

;CLEAR CKSUM
CLRCK	LDA #0
	STA CKSUM+1
	STA CKSUM
	RTS

;CODE FOR PAGE ZERO SIMULTAION
;SUBR LDAY-SIMULATES LDA (N),Y INSTR WITHOUT PAG 0
;BY PUTTING INDIRECT ADDR INTO RAM & THEN EXEC LDA NM,Y
PCLLD	LDA #<SAVPC      ;FOR DISASSEMBLER
LDAY	STY CPIY+3       ;SAVE Y
	TAY
	LDA MONRAM,Y     ;MONRAM=MONITOR RAM
	STA LDIY+1
	LDA MONRAM+1,Y
	STA LDIY+2
	LDY CPIY+3       ;REST Y
	LDA #$B9         ;INST FOR LDA NM,Y
	STA LDIY
	LDA #$60         ;RTS
	STA LDIY+3
	JMP LDIY         ;START EXECUTING LDA (),Y

;SUBR STORE AT ADDR & CMP WITOUT PAG 0
;REPLACES STA (ADDR),Y & CMP (ADDR),Y
;LOOK THAT ADDR & ADDR+1 ARE NOT ON PAG 0
SADDR	PHA
	LDA ADDR
	STA STIY+1
	STA CPIY+1
	LDA ADDR+1
	STA STIY+2
	STA CPIY+2
	LDA #$99         ;STA INSTR
	STA STIY
	LDA #$D9         ;CMP INSTR
	STA CPIY
	LDA #$60         ;RTS
	STA CPIY+3
	PLA
	JMP STIY         ;START EXECUTING STA ( ),Y

;PUSH X & Y WITHOUT CHANGING REGS
PHXY	STA CPIY+3      ;SAVE ACC
	TYA
	PHA              ;PUSH Y
	TXA
	PHA              ;PUSH X
	JSR SWSTAK       ;SWAP X , Y WITH RTRN ADDR FROM SU
	LDA CPIY+3
	RTS

;PULL X & Y WITHOUT CHANGING ACC
;IT HAS TO BE CALLED BY JSR & NOT BY JMP INSTR
;SINCE IT SWAPS THE STACK
PLXY	STA CPIY+3
	JSR SWSTAK       ;SWAP X , Y WITH RTRN ADDR FROM
	PLA
	TAX              ;PULL X
	PLA
	TAY              ;PULL Y
	LDA CPIY+3
	RTS

;SWAP STACK
SWSTAK	TSX
	LDA #2
SWST1	PHA
	LDA $0106,X      ;GET PCH OR PCL
	LDY $0104,X      ;GET Y OR X REGS
	STA $0104,X
	TYA
	STA $0106,X
	DEX
	PLA
	SEC
	SBC #1
	BNE SWST1
	LDA $0108,X      ;RESTORE Y & X FROM STACK
	TAY
	LDA $0107,X
	TAX
	RTS
.PAGE 'I/O SUBROUTINES'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;GET A CHAR FROM TTY SUBR INTO ACC ,SAVEX X
GETTTY	TXA              ;SAVE X
	PHA
	LDX #$07         ;SET UP FOR 8 BIT CONT
	STX CPIY         ;CLEAR MSB
GET1	BIT DRB          ;A^M , PB6->V
	BVS GET1         ;WAIT FOR START BIT
	JSR DELAY        ;DELAY ONE BIT
	JSR DEHALF       ;DELAY 1/2 BIT TIME
GET3	LDA DRB          ;GET 8 BITS
	AND #$40         ;MASK OFF OTHE RBITS,ONLY PB6
	LSR CPIY         ;SHIFT RIGHT CHARACTER
	ORA CPIY
	STA CPIY
	JSR DELAY        ;DELAY 1 BIT TIME
	DEX
	BNE GET3         ;GET NEXT BIT
	JSR DELAY        ;DO NOT CARE FOR PARITY BIT
	JSR DEHALF       ;UNTIL WE GET BACK TO ONE AGAIN
	PLA              ;RESTORE X
	TAX
	LDA CPIY
	AND #$7F         ;CLEAR PARITY BIT
	RTS

;DELAY 1 BIT TIME AS GIEN BY BAUD RATE
DELAY	LDA CNTL30       ;START TIMER T2
	STA T2L
	LDA CNTH30
DE1	STA T2H
DE2	LDA IFR          ;GET INT FLG FOR T2
	AND #MT2
	BEQ DE2          ;TIME OUT ?
	RTS

;DELAY HALF BIT TIME
;TOTLA TIME DIVIDED BY 2
DEHALF	LDA CNTH30
	LSR A            ;LSB TO CARRY
	LDA CNTL30
	ROR A            ;SHIFT WITH CARRY
	STA T2L
	LDA CNTH30
	LSR A
	STA T2H
	JMP DE2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
GETKDO	LDA #0
	STA IDOT         ;GO ANOTHER 90 DOTS
	JSR IPO0         ;OUTPUT 90 DOTS TO PRI (ZEROS)

;GET CHAR FROM KB SUBROUTINE
;FROM KB Y=ROW ,STBKEY=COLUMNS (STROBE)
;X=CTRL OR SHIFT ,OTHERWISE X=0
GETKEY	JSR ROONEK       ;WAIT IF LAST KEY STILL DOWN
GETKY	JSR DEBKEY       ;DEBOUNCE KEY (5 MSEC)
;CTRL OR SHIFT ?
	LDA #$8F         ;CHCK CLMN 5,6,7
	STA DRA2
	LDA DRB2         ;CHCK ROW 1
	LSR A
	BCS GETK1        ;IF=1 ,NO CTRL OR SHIFT
	LDX #3           ;CLMN 5,6,7 (CNTRL,SHIFTL,SHIFTR)
	LDA #$7F         ;CTRL OR SHIFT ,SO WHICH ONE ?
GETKO	SEC
	ROR A
	PHA
	JSR ONEK2        ;LETS GET CTRL OR SHIFT INTO X
	LDA DRB2
	LSR A            ;ONLY 1 ROW
	BCC GETKOO       ;GOT YOU
	PLA
	DEX
	BNE GETKO
	BEQ GETKY        ;THERE IS A MISTAKE CHECK AGAIN
GETKOO	PLA              ;NOW GET STBKEY INTO X
	LDA STBKEY       ;CLMN INTO X
	EOR #$FF         ;COMPLEMENT BECAUSE STRBS ARE 0
	TAX              ;CTRL OR SIFT TO X
	INC KMASK        ;SET MASK=$01
;NOW GET ANY KEY
GETK1	JSR ONEKEY       ;GET A KEY
	DEY              ;CHK THE ROW (1-8)
	BNE GETK1B       ;CHCK IF CTRL OR SHIFT
	LDA STBKEY       ;WERE ENTERED AT THE LAST MOMENT
	CMP #$F7         ;IF CLMN 5,6,7,8 DO IT AGAIN
	BCS GETK2
	BCC GETKY        ;SEND IT TO GET CTRL OR SHIFT
GETK1B	BMI GETKY        ;NO KEY ,CLEAR MSK
;WE HAVE A KEY ,DECODE IT
GETK2	JSR DEBK1        ;DEBOUNCE KEY (5 MSEC)
	TYA              ;MULT BY 8
	ASL A
	ASL A
	ASL A
	TAY              ;NOW Y HAS ROW ADDR FROM ROW 1
	LDA STBKEY       ;ADD COLUMN TO Y
GETK3	LSR A
	BCC GETK4
	INY
	BNE GETK3
GETK4	LDA ROW1,Y       ;GET THE CHR
	PHA
	TXA              ;SEE IF CTRL OR SHIFT WAS USED
	BEQ GETK7        ;BRCH IF NO CTRL OR SHIFT
	AND #$10         ;CTRL ?
	BEQ GETK5        ;NO ,GO GETK5
	PLA
	AND #$3F         ;MSK OFF 2 MSB FRO CONTROL
	JMP GETK8        ;EXIT
GETK5	PLA
	PHA              ;SAVE IT
	AND #$40         ;IF ALPHA CHARS DO NOT SHIFT
	BNE GETK7
	PLA
	PHA
	AND #$0F         ;ONLY LSB
	BEQ GETK7        ;DO NOT INTERCHANGE (SPACE) OR 0
	CMP #$0C         ;ACC>=$0C ?
	BCS GETK6        ;YES ACC>=$0C
	PLA              ;NO, ACC<$0C
	AND #$EF         ;STRIP OFF BIT 4
	BNE GETK8        ;EXIT
GETK6	PLA              ;ACC>=$0C
	ORA #$10         ;BIT 4= 1
	BNE GETK8        ;EXIT
GETK7	PLA
;CHECK FOR 'ADV PAP', "PRI LINE", OR "TOGL PRIFLG"
;IN THIS WAY WE DONT HAVE TO CHCK FOR THIS COMM
GETK8	CMP #$60         ;ADV PAPER COMM
	BNE GETK11
	CPX #0           ;IF SHIFT IS NOT ADV PAPER
	BEQ GETK10       ;NO SHIFT ,SO ADV PAPER
	AND #$4F         ;CONVERT TO "@"
GETK11	CMP #$1C         ;SEE IF TOGGL PRIFLG (CONTROL PRI)
	BNE GETK13
	JSR PRITR        ;GO TOGGLE FLG
	LDY #1           ;GET THE PTRS BACK 3 SPACES
GETK12	LDA CURPO2,Y
	SEC
	SBC #3           ;BECAUSE 'ON ,OFF' MSGS
	STA CURPO2,Y
	DEY
	BPL GETK12
	JMP GETKEY
GETK13	CMP #'\          ;PRINT LINE COMMAND
	BNE GETK14
	JSR IPSO         ;PRINT WHATEVER IS IN BUFFER
	JMP GETKEY
GETK14	RTS
GETK10	JMP GETKDO

;WAIT IF LAST KEY STILL DOWN (ROLLOVER)
ROONEK	LDA DRB2         ;SEE IF KEY STILL DOWN
	CMP #$FF
	BEQ R001         ;NO KEY AT ALL, CLR ROLLFL
	ORA ROLLFL       ;ACCEPT ONLY LAST KEY
	EOR #$FF         ;STRBS ARE ZERO SO INER
	BNE ROONEK
	JSR DEBKEY       ;CLR KMASK & DEBOUNCE RELEASE
R001	LDA #0           ;CLR KMASK
	STA KMASK
;GO THRU KB ONCE AND RTN ,IF ANY
;KEY Y=ROW (1-8) & STRBKEY=CLMN
;IF NO KEY Y=0 ,STBKEY=$FF
ONEKEY	LDA #$7F         ;FISRT STROBE TO MSB
	BNE ONEK2        ;START AT ONEK2
ONEK1	SEC              ;ONLY ONE PULSE (ZERO)
	ROR A            ;SHIFT TO RIGHT
ONEK2	STA DRA2         ;OUTPUT CLMN STROBE
	STA STBKEY       ;SAVE IT
	LDY #8           ;CHECK 8 ROWS
	LDA DRB2         ;ANY KEY ?
	ORA KMASK        ;DISABLE ROW 1 IF CRTL OR SHIFT
	STA ROLLFL       ;SAVE WHICH KEY IT WAS
ONEK3	ASL A
	BCC ONEK4        ;JUMP IF KEY (ZERO)
	DEY
	BNE ONEK3
	LDA STBKEY
	CMP #$FF         ;LAST CLMN ?
	BNE ONEK1        ;NO ,DO NEXT CLMN
ONEK4	RTS

DEBKEY	LDX #0           ;CLEAR CNTRL OR SHIFT
DEBK1	LDA #0           ;CLR KMASK
	STA KMASK
	LDA #<DEBTIM     ;DEBOUNCE TIME FOR KEYBOARD
	STA T2L
	LDA #>DEBTIM
	JMP DE1          ;WAIT FRO 5 MSEC

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;GET A CHAR FROM TAPE SUBROUTINE
;A BUFFER IS USED TO GET BLOCKS OF DATA
;FROM TAPE ,EXCEPT WHEN FORMAT EQUAL TO
;KIM-1 (THE WHOLE FILE IS LOADED AT ONE TIME)
TIBYTE	JSR PHXY         ;PUSH X
	LDX TAPTR        ;POINTER FOR BUFFER
	CPX #80          ;IS BUFFER EMPTY ?
	BNE TIB1
	JSR TIBY1        ;LOAD ANOTHER BLOCK
TIB1	LDA TABUFF,X
	INX
	STX TAPTR
	JSR PLXY         ;PULL X
	RTS
;LOAD A BLOCK FROM TAPE INTO BUFFER
TIBY1	JSR TAISET       ;SET TAPE FOR INPUT
TIBY3	JSR GETTAP       ;GET A CHAR FROM TAPE
	CMP #'#          ;CHECK FIRST CHAR FOR
	BEQ TIBY4        ;START OF BLOCK
	CMP #$16         ;IF NOT # SHOULD BE SYN
	BNE TIBY1
	BEQ TIBY3
TIBY4	LDX #0
TIBY5	JSR GETTAP       ;NOW LOAD INTO BUFFER
	STA TABUFF,X
	INX
	CPX #82
	BNE TIBY5
	LDA DRB
	AND #$CF
	STA DRB          ;TURN OFF TAPES
	CLI              ;ENABL INTERR
	JSR ADDBK1       ;DISPLAY BLK COUNT
	LDX #0           ;TO CLEAR PTR IN TIBYTE
	LDA BLK          ;CHECK THE BLOCK COUNT
	BEQ TIBY5A       ;IF FIRST BLOCK ,DO NOT CMP
	CMP TABUFF,X
	BNE TIBY7        ;BRANCH IF WE MISSED ONE BLOCK
TIBY5A	INX
	STX TAPTR
	INC BLK          ;INCR BLK CONT
	LDA TABUFF+81    ;STORE THIS BLK CKSUM
	PHA
	LDA TABUFF+80
	PHA
	DEC INFLG        ;SET INFLG DIFF FROM OUTFLG
	JSR BKCKSM       ;COMPUT BLK CKSUM FOR THIS BLK
	PLA
	CMP TABUFF+80    ;DO THEY AGREE ?
	BNE TIBY6
	PLA
	CMP TABUFF+81
	BNE TIBY7
	INC INFLG        ;RESTORE INPUT DEVICE
	LDX #1           ;TO GET FIRST CHR IN TIBYTE
	RTS
TIBY6	PLA              ;RESTORE STACK PTR
TIBY7	PLA
	PLA
	PLA
	PLA
	JSR CKERO
	JMP COMIN

;ADD 1 TO BLK COUNT AND OUTPUT IT
ADDBLK	INC BLK          ;INCR BLK CNT
ADDBK1	INC PRIFLG       ;SO DONT OUTPUT TO PRINTR
	LDA #18          ;ONLY OUTPUT IN THIS POSITION
	STA CURPO2
	LDA DIBUFF+18    ;SAVE DISBUFF (FOR EDIT)
	PHA
	LDA DIBUFF+19
	PHA
	LDX OUTFLG       ;SAVE OUTFLG
	LDA #CR
	STA OUTFLG       ;TO OUTPUT TO TERMINAL
	LDA BLK+1        ;BLK CNT COMING FROM TAPE
	JSR NUMA         ;OUTPUT IN ASCII
	STX OUTFLG       ;RESTORE OUTFLG
	PLA
	STA DIBUFF+19
	PLA
	STA DIBUFF+18
	DEC PRIFLG       ;RESTORE PRIFLG
	RTS

;SET TAPE (1 OR 2) FRO INPUT
TAISET	LDA #$37         ;SET PB7 FRO INPUT
	STA DDRB
	LDA TAPIN        ;INPUT FLAG (TAP 1=0 OR TAP 2=1)
	JSR TIOSET       ;RESET PB4 OR PB5
	LDA #MOFF+DATIN  ;SET CA2=1 (DATA IN)
	STA PCR
	LDA #$FF         ;PREPARE T2
	STA T2L          ;LACTH
;CHCK BIT BY BIT UNTIL $16
SYNC	JSR RDBIT        ;GET A BIT IN MSB
	LSR CPIY         ;MAKE ROOM FOR BIT
	ORA CPIY         ;PUT BIT IN MSB
	STA CPIY
	CMP #$16         ;SYN CHAR ?
	BNE SYNC
	LDX #$05         ;TEST FRO 5 SYN CHARS
SYNC1	JSR GETTAP
	CMP #$16
	BNE SYNC         ;IF NOT 2 CHAR RE-SYNC
	DEX
	BNE SYNC1
	RTS

;SET PB4 OR PB5 OFF
;USED BY IN/OUT SET UPS
TIOSET	BNE TIOS1        ;BRCH IF TAP1
	LDA #$14         ;SET TAPE 2 OFF (PB5=0)
	BNE TIOS2
TIOS1	LDA #$24         ;SET TAPE 1 OFF (PB4=0)
TIOS2	STA DRB
	SEI              ;DISABLE INTERR WHILE TAP
	RTS

;GET 1 CHAR FORM TAPE AND RETURN
;WITH CHR IN ACC, USE CPIY TO ASM CHR ,USES Y
GETTAP	LDY #$08         ;READ 8 BITS
GETA1	JSR RDBIT        ;GET NEXT DATA BIT
	LSR CPIY         ;MAKE ROOM FOR MSB
	ORA CPIY         ;OR IN SIGN BIT
	STA CPIY         ;REPLACE CHAR
	DEY
	BNE GETA1
	RTS
;GET ONE BIT FROM TAPE AND
;RETURN IT IN SIGN OF A (MSB)
RDBIT	LDA TSPEED       ;ARE WE IN C7 OR 5B,5A FREQUENCY
	BMI RDBIT4       ;JUMP TO C7 FREQ FROMAT
	JSR CKFREQ       ;START BIT IN HIGH FREC
RDBIT1	JSR CKFREQ       ;HIGH TO LOW FREQ TRANS
	BCS RDBIT1
	LDA DIV64        ;GET HIGH FREQ TIMING
	PHA
	LDA #$FF         ;SET UP TIMER
	STA DIV64
RDBIT2	JSR CKFREQ       ;LOW TO HIGH FREQ TRANS
	BCC RDBIT2       ;WAIT TILL FREQ IS HIGH
	PLA
	SEC
	SBC DIV64        ;(256-T1) - (256-T2) =T2-T1
	PHA              ;LOW FREQ TIME-HIGHT FREQ TIME
	LDA #$FF
	STA DIV64        ;SET UP TIMER
	PLA
	EOR #$FF
	AND #$80
	RTS
;EACH BIT STARTS WITH HALF PULSE OF 2400 & THEN
;3 HALF PULSES OF 1200 HZ FRO 0 ,3 PLUSES OF 2400 FOR 1
;THE READING IS MADE ONTHE FOURTH 1/2 PULSE ,WHERE
;THE SIGNAL HAS STABILIZED
RDBIT4	JSR CKFREQ       ;SEE WHICH FREQ
	BCC RDBIT4
	JSR CKFREQ
	JSR CKFREQ
	JMP PATC24       ;NOW READ THE BIT

CKFREQ	BIT DRB          ;ARE WE HIGH OR LOW ?
	BMI CKF4
CKF1	BIT DRB          ;WAIT TILL HIH
	BPL CKF1
	ADC $00          ;EQUALIZER
CKF2	LDA T2H          ;SAVE CNTR
	PHA
	LDA T2L
	PHA
	LDA #$FF
	STA T2H          ;START CNTR
	LDA TSPEED
	BMI CKF3         ;SUPER SPEED ?
	PLA
	CMP TSPEED       ;HIGH OR LOW FREC
	PLA              ;C=1 IF HIGH ,C=0 IF LOW
	RTS
CKF3	PLA
	CMP TSPEED       ;CENTER FREQ
CKF3A	PLA
	SBC #$FE
	RTS
CKF4	BIT DRB          ;WAIT TILL LOW
	BMI CKF4
	BPL CKF2         ;GO GET TIMING

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO TTY SUBROUTINE
;X,Y ARE PRESERVED
OUTTTY	PHA              ;SAVE A
	JSR PHXY         ;PUSH X
	STA STIY         ;PUT CHAR HERE
	JSR DELAY        ;STOP BIT FROM LAST CHAR
	LDA DRB
	AND #$FB         ;START BIT PB2=0
	STA DRB          ;TTO=PB2
	STA STIY+1       ;SAVE THIS PATTERN
	JSR DELAY
	LDX #$08         ;8 BITS
	ROL STIY         ;GET FIRST LSB INTO BIT 2
	ROL STIY
	ROL STIY
OUTT1	ROR STIY
	LDA STIY
	AND #$04         ;GET ONLY BIT 2 FOR PB2
	ORA STIY+1       ;PUT BIT INTO PATTERN
	STA DRB          ;NOW TO TTY
	PHP              ;PRESERVE CARRY FOR ROTATE
	JSR DELAY
	PLP
	DEX
	BNE OUTT1
	LDA #$04         ;STOP BIT
	ORA STIY+1
	STA DRB
	JSR DELAY        ;STOP BIT
	JSR PLXY         ;PULL X
	PLA
	CMP #LF
	BEQ OUTT2
	CMP #NULLC
	BEQ OUTT2
	JMP OUTDIS       ;USE THAT BUFF
OUTT2	RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT A CHR TO D/P SUBR (SINGLE ENTRY FOR BOTH SUBR)
;IF CHAR=<CR> CLEAR DISPLAY & PRINTER
OUTDP	JSR OUTPRI       ;FIRST TO PRI THEN TO DISP
	NOP
	NOP
	NOP
OUTDP1	JMP (DILINK)     ;HERE HE COULD ECHO SOMEWHERE ELSE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO DISPLAY SUBROUTINE
;IF SIGN BIT (MSB)=1 DISPL DO NOT CLR TO THE RIGHT
OUTDIS	PHA              ;SAVE A
	JSR PHXY         ;PUSH X
	CMP #CR          ;<CR>?
	BNE OUTD1
	LDX #0           ;YES
	STX CURPO2       ;CLEAR DISP POINTER
	BEQ OUTD5        ;GO CLEAR DISP
OUTD1	JMP PATCH4
OUTD1A	CPX #60          ;LAST CHAR FOR DISP?
	BCC OUTD2
	JSR PLXY         ;GO BACK
	PLA              ;DO NOT STORE
	RTS
OUTD2	STA DIBUFF,X     ;PUT CHAR IN BUFF
	INC CURPO2       ;INC POINTER
	CPX #20          ;DISPLAY FULL?
	BCC OUTD4
	JSR OUTD2A       ;THIS WAY SCROLL IS A SUBR
	BMI OUTD7        ;EXIT DISP
;YES, SCROLL CHARS TO THE LEFT
OUTD2A	TXA              ;X---> Y
	TAY
	LDX #19          ;ADDR FOR DISP DO NOT
OUTD3	STX STIY         ;DECREM IN BINARY
	LDA DIBUFF,Y     ;FROM BUFFER TO DISP
	ORA #$80         ;NO CURSOR
	JSR OUTDD1       ;CONVERT X TO REAL ADDR
	DEY
	DEC STIY
	LDX STIY
	BPL OUTD3        ;AGAIN UNTIL WHOLE DISP
	RTS
OUTD4	PHA
	ORA #$80         ;NO CURSOR
	JSR OUTDD1       ;X=<$19 ,CONVRT TO REAL ADDR
	PLA
	AND #$80         ;IF MSB=0 CLEAR REST OF DISPLAY
	BNE OUTD7
	LDX CURPO2
;CLEAR DISP TO THE RIGHT
OUTD5	CPX #20
	BCS OUTD7
	STX STIY
	LDA #$A0         ;<SPACE>
	JSR OUTDD1       ;CONVRT TO REAL ADDR
	INC STIY
	LDX STIY
	BNE OUTD5        ;GO NEXT
	JMP OUTD7
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
OUTD7	JSR PLXY         ;REST ,SO PRINTR INDEPEN
	PLA
	RTS

;CONVERT X INTO REAL ADDR FOR DISPLAY
;AND OUTPUT IT PB=DATA ; PA=W,CE ,A0 A1 (6520)
OUTDD1	PHA              ;SAVE DATA
	TXA
	PHA              ;SAVE X
	LSR A            ;DIVIDE X BY 4
	LSR A            ;TO GET CHIP SELECT
	TAX              ;BACK TO X
	LDA #4           ;FIRST CHIP SELECT
	CPX #0           ;FIRST CHIP ?
	BEQ OUTDD3
OUTDD2	ASL A
	DEX
	BNE OUTDD2       ;BACK TILL RIGH CS
OUTDD3	STA STIY+1       ;SAVE CS TEMPORARILY
	PLA              ;GET X AGAIN FOR CHAR
	AND #03          ;IN THAT CHIP
	ORA STIY+1       ;OR IN CS AND CHAR
;STORE ADDR AND DATA INTO DISPL
	EOR #$FF         ;W=1 , CE=0 & A1,A0
	STA RA
	TAX             ;SAVE A IN X
	PLA             ;GET DATA
	PHA
	STA RB
	TXA
	EOR #$80         ;SET W=0
	STA RA
	NOP
	ORA #$7C         ;SET CE=1
	STA RA
	LDA #$FF         ;SET W=1
	STA RA
	PLA              ;RETURN DATA
	RTS

	*=$EFF9
	.BYT $EA
	*=$F000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO PRINTER SUBROUTINE
;PRINTS ON 21RST CHAR OR WHEN (CR)
;IT WILL PUT IT ON BUFFER BUT WONT PRINT IF
;PRIFLG=0
OUTPRI	PHA              ;SAVE CHR TO BE OUTPUT
	JSR PHXY         ;SAVE X
	CMP #$0D         ;SEE IF CR
	BEQ OUTO1        ;YES SO PRINT THE BUFF
	LDX CURPOS       ;PTR TO NEXT PSO IN BUFF
	CPX #20          ;SEE IF BUFF FULL
	BNE OUT04        ;NOT FULL SO RETURN
;(CR) SO FILL REST OF BUFFER WITH BLANKS
OUTO1	PHA
	LDA #0           ;CURPOS = 0
	LDX CURPOS       ;SEE IF ANYTHING IN BUFFER
	STA CURPOS
	JSR OUTPR        ;CLEAR PRIBUFF TO RIGHT
;BUFFER FILLED SO PRINT IT
	JSR IPST         ;START THE PRINT
	LDX #0           ;STORE CHR IN BUFF (FIRST LOC)
	PLA              ;GET IT
	CMP #CR          ;DONT STORE IF (CR)
	BEQ OUT05
OUT04	STA IBUFM,X      ;STORE CHR IN BUFF
	INC CURPOS       ;INCR BUFF PNTR
	INX
	AND #$80
	BNE OUT05        ;DONT CLR IS MSB=1
	JSR OUTPR        ;CLEAR PRIBUFF TO THE RIGHT
OUT05	JSR PLXY         ;RESTORE REGS
	PLA
	RTS
OUTPR	LDA #$20         ;FILL REST OF BUFF WIT BLANKS
OUTPR1	CPX #20          ;SEE IF END OF BUFF
	BEQ OUTPR2
	STA IBUFM,X      ;NO SO STORE BLANK
	INX              ;INCR BUFF PNTR
	BPL OUTPR1
OUTPR2	RTS

;SUB TO OUTPUT BUFFER, 70 DOTS (10 DOTS AT
;A TIME BY 7 ROWS) FOR EACH LINE OF PRINTING
IPST	BIT PRIFLG       ;PRINT FLG ON ?
	BPL IPO4
IPSO	JSR PINT         ;INITIALIZE VALUES
	JSR IPSU         ;SET UP FIRS OUTPUT PATTERN
IPO0	LDA #PRST+SP12+MON ;TURN MOTOR ON
	STA PCR
	JSR PAT23        ;TIME OUT?
	BNE IPO2         ;NO, START SIGNAL RECEIVED
	JSR PAT23        ;YES, TRY AGAIN
	BNE IPO2
	JMP PRIERR       ;TWO TIMEOUT - ERROR
	NOP
	NOP
	NOP
	NOP
IPO2	JSR PRNDOT       ;STRB P1=1 PRINT DOTS (1.7MSEC)
	JSR PRNDOT       ;STRB P2=1 PRINT DOTS (1.7MSEC)
;CHECK FOR 90, WHEN 70 PRNDOT WILL OUTPUT ZEROS
	LDA IDOT
	CMP #90
	BCC IPO2         ;L.T. 90 THEN GOTO STROB P1
IPO3	LDA #PRST+SP12+MOFF ;TIRN MOTOR OFF
	STA PCR
IPO4	RTS

PRIERR	JSR CLR          ;CLEAR PRI PNTR
	JSR PATCH5       ;PURN PRI OFF
	LDY #M12-M1
	JSR KEP
	JMP COMIN        ;BACK WHERE SUBR WAS CALLED

;SUBR TO INCR DOT COUNTER,WHEN
;NEG TRANS OUTPUT CHR FOR 1.7 MSEC
;CLEAR & SET UP NEXT PATTERN
PRNDOT	LDA #0           ;CLR INTERRUPTS
	STA DRAH
PRDOT0	LDA IFR
	AND #MSP12       ;ANY STROBES
	BEQ PRDOT0
	LDA PCR
	EOR #$01
	STA PCR
	INC IDOT
	LDA IOUTU        ;2 LEFT ELEM
	ORA DRB          ;DO NOT TURN TTY OUTPUT OFF
	STA DRB
	LDA IOUTL        ;T RIGTH ELEM, CLR CA1 INTER FLG
	STA DRAH
	LDA #<PRTIME
	STA T2L
	LDA #>PRTIME     ;START T2 FOR 1.7 MSEC
	STA T2H
	JSR IPSU         ;SET NEXT PATTER WHILE WAITING
	JSR DE2          ;WAIT TILL TIME OUT
	LDA #0           ;THERNAL ELEM OFF
	STA DRAH
	LDA DRB          ;BUT DONT CHANGE TAPE CONTROLS
	AND #$FC
	STA DRB
	RTS

; SUBROUTINE PINT -- INIT VARS FOR PRINTER
PINT	LDA #$FF
	STA IDIR         ;DIRECTION <= -
	LDA #5
	STA ICOL         ;COLUMN <= LEFTMOST +1
	LDA #1
	STA IOFFST       ;OFFSET <= LEFT CHARACTER
	STA IMASK
	LDA #0
	STA IDOT         ;DOC COUNTER <= 0
	RTS

;THE VARIABLES FOR THE PRINTER ARE AS FOLLOWS
;
;IDIR   DIRECT HEAD IS CURRENTLY MOVING (0=+, $FF=-)
;ICOL   CLMN TO BE PRINTED NEXT (LEFTMOST=0,RIGHTMOST=4
;IOFFST OFFSET N PRINT BUFF (0=LEFT CHR, 1=RIGHT CHR)
;IDOT   COUNT OF NUMBER OF DOTS PRINTED THUS FAR
;IOUTL  SOLENOID PATTERN (8 CHARS ON RIGHT)
;IOUTU  SOLENOID PATTERN (2 CHRS ON LEFT)
;IBITL  1 BIT MSK USED IN SETTING NEXT SOLENOID VALUE
;IBITU  START OF PRINT BUFFER
;IBUFM  START OF PRINT BUFFER (LEFTMOST CHR FIRST)
;IMASK  MARK FOR CURRENT ROW BEING PRINTED
;JUMP   ADDRESS OF TABLE FOR CURRENT COLUMN
;
;   THE DOT PATTERNS FOR THE CHRS ARE STORED TO THAT...
;EACH BYTE CONTAINS THE DOTS FOR ONE COLUMN OF ONE...
;CHR. SINCE EACH COLUMN CONTAINS SEVEN DOTS ,
;THIS MEANS THAT ONE BIT PER BYTE IS USED.
;   THE PATTERNS ARE ORGANIZED INTO 5 TABLES OF 64...
;BYTES WHERE EACH TABLE CONTAINS ALL THE DOT...
;PATTERNS FOR A PARTOCULAR COLUMN. THE BYTES IN EACH...
;TABLE ARE ORDERED ACCORDING TO THE CHR CODE OF...
;THE CHR BEING REFERENCED. THE CHR CODE CAN...
;THUS BE USED TO DIRECTLY INDEX INTO THE TABLE.
;
;SUBROUTINE IPSU -- SET UP OUTPUT PATTERN FOR PRINTER
;   THIS ROUTINE IS CALLED IN ORDER TO
;SET UP THE NEXT GROUP OF SOLENOIDS TO
;BE OUTPUT TO THE PRINTER
;   ON NETRY THE CONTENTS OF ALL RESGISTERS
;ARE ARIBTRARY
;   ON EXIT THE CONTENTS OF A,X,Y ARE UNDEFINED
IPSU	LDX #0           ;X POINTS TO VAR BLOCK FOR PRNTR
	JSR INCP         ;ADVANCE PTRS TO NEXT DOT POSITION
;X NOW CONTAINS INDEX INTO PRINT BUFFER
IPS1	LDA IBUFM,X      ;LOAD NEXT CHAR FROM BUFFER
	AND #$3F
	TAY
	LDA #<JUMP       ;A<= DOT PATTERN FOR CHAR & COL
	JSR LDAY
	BIT IMASK        ;SEE IF DOT IS SET
	BEQ IPS2         ;NO SO GO ON TO NEXT CHAR
	LDA IBITL        ;DOT ON SO SET THE CURR SOLENOID
	BEQ IPS3         ;LSB OF SOL MASK IS 0 , DO MSB
	ORA IOUTL        ;SET THE SOLENOID IN THE PATTERN
	STA IOUTL
	BNE IPS2         ;BRANCH ALWAYS
IPS3	LDA IBITU        ;SOLENOID IS ONE OF THE 2 MSD
	ORA IOUTU        ;SET THE BIT IN THE PATTERN
	STA IOUTU
IPS2	ASL IBITL        ;SHIFT MASK TO NXT CHR POSITION
	ROL IBITU
	DEX              ;DECR PTR INTO BUFFER
	DEX
	BPL IPS1         ;NOT END YET
;SOLENOID PATTERN IS SET UP IN IOUTU,IOUTL
	LDA IOUTU        ;LEFTMOST 2
	AND #$3          ;DISABLE FRO SEGEMENTS
	STA IOUTU
	RTS

;SUBROUTINE INCP
;THIS SUBROUTINE IS USED TO UPDATE THE PRINTER VARIABLES
;TO POINT TO TEH NEXT DOT POSITION TO BE PRINTED
;X REG IS USED TO POINT TO THE VARIABLE BLOCK OF
;BEING UPDATED
;ON EXIT X CONTAINS THE POINTER TO THE LAST CHARACTER IN
;THE PRINT BUFFER
;CONTENTS OF A,Y ON EXIT ARE ARIBTRARY
INCP	LDA IDIR,X       ;EXAMINE DIRECTION (+ OR -)
	BPL OP03         ;DIRECTION = +
;*DIRECTION = -
	LDA ICOL,X       ;SEE WHAT THE COLUMN IS
	BEQ OP04         ;COLUMN = 0 SO END OF DIGIT
;**COLUMN # 0 SO JUST DECREMENT COLUMN
	DEC ICOL,X
	BPL NEWCOL       ;BRANCH ALWAYS
;**COLUMN = 0 SO SEE IF EVEN OR ODD DIGIT
OP04	LDA IOFFST,X
	BEQ OP07         ;OFFSET = 0 SO DIREFTION CHANGE
;***OFFSET = 1 SO MOVE TO RIGHT DIGIT
	DEC IOFFST,X     ;OFFSET <= 0 (LEFT CHARACTER)
	LDA #4           ;COLUMN <= 4
	STA ICOL,X
	BPL NEWCOL       ;BRANCH ALWAYS
;***OFFSET = 0 SO CHANGE DIRECTION TO +
OP07	INC IDIR,X       ;DIRECTION <= $00 (+)
	BPL NEWROW       ;BRANCH ALWAYS
;*DIRECTION = +
OP03	LDA ICOL,X       ;SEE IF LAST COLUMN IS DIGIT
	CMP #4
	BEQ OP05         ;COLUMN = 4 GO TO NEXT DIGIT
	INC ICOL,X       ;JUST INCR COLUMN-NOT END OF DIGIT
	BPL NEWCOL       ;BRANCH ALWAYS
;**AT COLUMN 4 -- SEE IF LEFT OR RIGHT DIGIT
OP05	LDA IOFFST,X
	BNE OP06         ;OFFSET #0 SO RIGHT DIGIT
	STA ICOL,X       ;COLUMN <= 0
	INC IOFFST,X     ;OFFSET <= 1 (RIGHT CHARACTER)
	BPL NEWCOL       ;BRANCH ALWAYS
;***OFFSET = 1 SO DIRECTION CHANGE
OP06	DEC IDIR,X       ;DIRECTION <= $FF (-)

;START OF NEW PRINT ROW
NEWROW	ASL IMASK,X      ;UPDATE ROW MASK FOR DOT PATTERN
;SATRT OF NEW PRINT COLUMN
NEWCOL	LDA #0           ;CLEAR OUTPUT PATTERN
	STA IOUTL,X      ;PATTERN FOR 8 RIGHT CHRS
	STA IOUTU,X      ;PATTERN FOR 2 LEFT SOLEN
	STA IBITU,X      ;OUTPUT MSK FRO LEFTMOST SOLEN
	LDA #1
	STA IBITL,X      ;OUTPUT MSK FRO RIGHMOST SOELN
;GET ADDRESS OF DOT PATTERN TABLE FOR NEXT COLUMN
	LDA ICOL,X       ;GET COLUMN NUMBER (0-4)
	ASL A            ;*2 ,INDEX INTO TBL OF TBL ADDRS
	TAY
	LDA MTBL,Y       ;LSB OF ADDR OF TABLE
	STA JUMP,X       ;PTR TO TBL WITH DOT PATTERNS
	LDA MTBL+1,Y     ;MSB OF TABLE ADDRESS
	STA JUMP+1,X
	LDA #18          ;COMPUTER INDEX INTO PRNTR BUFFER
	ORA IOFFST,X     ;+1 IF RIGHT CHR
	TAX
	RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO TAPE BUFFER SUBROUTINE
; & WHEN FULL OUTPUT BUFF TO TAPE
; IF INFLG=OUTFLG= T USE TWO BUFFERS
;OTHERWISE USE SAME BUFFER FROR INPUT
;AND OUTPUT (MONIT BUFFER)
TOBYTE	JSR PHXY         ;SAVE X
	LDX TAPTR2       ;TAPE BUFFER POINTER FOR OUTPUT
	JSR BKCK2        ;STORE IN BUFFER
	INX
	STX TAPTR2       ;FOR NEXT
	CPX #80          ;BUFFER FULL?
	BNE TABY3        ;NO , GO BACK
;OUTPUT A BLOCK FROM BUFFER TO TAPE
	JSR BKCKSM       ;COMPUTE BLOCK CHECKSUM
	JSR TAOSET       ;SET TAPE FOR OUTPUT
	LDA #'#          ;CHAR FOR BEGINNING
	JSR OUTTAP       ;OF BLOCK
;OUTPUT CHRS FROM ACTIVE BUFFER
TABY2	JSR CKBUFF       ;LOAD CHR FORM ACTIVE BUFFER
	JSR OUTTAP       ; FROM BUFFER
	INX
	CPX #83          ;2 BLOCK CKSUM CHAR + 1 EXTRA CHR
	BNE TABY2        ;OTHERWISE ERROR
	LDA DRB
	AND #$CF         ;TURN TAPES OFF PB5,PB4
	STA DRB
	CLI              ;ENABLE INTERRUPT
	LDA #0
	STA TAPTR2       ;CLR TAPE BUFF PTR
	LDA #T1I         ;RESET FREE RUNNING TO 1 SHOT
	STA ACR
	JSR PAT22        ;ADD 1 TO BLK COUNT & OUTPUT
	LDA BLKO         ;PUT BLK CNT IN FIRST LOC (TABUFF)
	JSR TOBYTE
TABY3	JSR PLXY
	RTS

;CHCK ACTIVE BUFFER AND LAOD A CHAR
;CARRY=0 IF ONLY 1 BUFFER ,C=1 IF 2 BUFFERS
CKBUFF	LDA INFLG
	CMP OUTFLG
	BNE CBUFF1
	CMP #'T          ;SEE IF INFLG=OUTFLG = T
	BNE CBUFF1
	SEC              ;USE PAGE 1 FOR OUTPUT BUFFER
	LDA TABUF2,X
	RTS
CBUFF1	CLC              ;USE SAME BUFFER FRO I/O
	LDA TABUFF,X
	RTS

;COMPUTER BLOCK CHECKSUM & PUT IT
;AT THE END OF ACTIVE BUFFER
BKCKSM	LDA #0           ;CLEAR BLK CKSUM LOCAT
	STA TABUFF+80
	STA TABUFF+81
	LDX #79
BKCK1	JSR CKBUFF       ;GET CHR FROM EITHER BUFFER
	CLC
	ADC TABUFF+80    ;ADD CKSUM
	STA TABUFF+80
	BCC *+5
	INC TABUFF+81
	DEX
	BPL BKCK1        ;DO THE WHOLE BUFFER
	LDX #80
	LDA TABUFF+80    ;PUT CKSUM INTO RIGTH BUFFER
	JSR BKCK2
	INX
	LDA TABUFF+81
BKCK2	PHA              ;OUTPUT A CHAR TO RIGTH BUFFER
	JSR CKBUFF       ;GET WHICH BUFFER
	PLA
	BCS BKCK3        ;BRANCH TO SECOND BUFFER
	STA TABUFF,X
	RTS
BKCK3	STA TABUF2,X     ;TO PAG 1
	RTS

;SET TAPE (1 OR 2) FRO OUTPUT
TAOSET	JSR SETSPD       ;SET UP SPEED (# OF HALF PULSES)
	LDA TAPOUT       ;OUTPUT FLG (TAPE 1 OR 2)
	JSR TIOSET       ;SET PB4 OR PB5 TO SERO
	LDA #DATOUT+MOFF ;SET CA2=0 (DATA OUT)
	STA PCR
	LDA #T1FR        ;SET TIMER IN FREE RUNNING
	STA ACR
	LDA #00
	STA T1CH         ;START TIMER 1
	LDX GAP          ;OUTPUT 4 * GAP SYN BYTES
TAOS1	LDA #$16         ;SYN CHAR
	JSR OUTTAP       ;TO TAPE
	JSR OUTTAP
	JSR OUTTAP
	JSR OUTTAP
	DEX
	BNE TAOS1
	RTS

;OUTPUT ACC TO TAPE
OUTTAP	STX CPIY+3       ;SAVE X
	LDY #$07         ;FOR THE 8 BITS
	STY STIY
	LDX TSPEED
	BMI OUTTA1       ;IF ONE IS SUPER HIPER
	PHA
TRY	LDY #2           ;SEND 3 UNITS
	STY STIY+1       ;STARTING AT 3700 HZ
ZON	LDX NPUL,Y       ;#OF HALF CYCLES
	PHA
ZON1	LDA TIMG,Y       ;SET UP LACTH FRO NEXT
	STA T1LL         ;PULSE (80- OR CA) (FREC)
	LDA #0
	STA T1LH
ZON2	BIT IFR          ;WAIT FRO PREVIOUS
	BVC ZON2         ;CYCLE (T1 INT FLG)
	LDA T1L          ;CLR INTERR FLG
	DEX
	BNE ZON1         ;SEND ALL CYCLES
	PLA
	DEC STIY+1
	BEQ SETZ         ;BRCH IF LAST ONE
	BMI ROUT         ;BRCH IF NO MORE
	LSR A            ;TAKE NEXT BIT
	BCC ZON          ;....IF IT'S A ONE...
SETZ	LDY #0           ;SWITCH TO 2400 HZ
	BEQ ZON          ;UNCONDITIONAL BRCH
ROUT	DEC STIY         ;ONE LESS BIT
	BPL TRY          ;ANY MORE? GO BACK
ROUT1	PLA              ;RECOVER CHR
	LDX CPIY+3       ;RESTORE X
	RTS

;OUTPUT HALF PULSE FRO 0 (1200 HZ) &
;TWO HALF PULSES FOR 1 (2400HZ) (00 TSPEED)
OUTTA1	PHA
	STA STIY+1       ;STORE ACC
OUTTA2	LDX #2           ;# OF HALF PULSES
	LDA #$D0         ;1/2 PULSE OF 2400
	STA T1LL
	LDA #00
	STA T1LH
	JSR PATC25       ;WAIT TILL COMPLETED
	LSR STIY+1       ;GET BITS FROM CHR
	BCS OUTTA3
	LDA #$A0         ;BIT=0 ,OUTPUT 1220 HZ
	STA T1LL
	LDA #$01
	STA T1LH
OUTTA3	JSR PATC25
	DEX
	BPL OUTTA3       ;OUTPUT 3 HALF PULSES
	DEY
	BPL OUTTA2
	JMP ROUT1        ;RESTORES REGS
	NOP
	NOP
;SET SPEED FROM NORMAL TO 3 TIMES NORMAL
SETSPD	LDA TSPEED       ;SPEED FLG
	ROR A            ;NORMAL OR 3* NORM
	LDA #12
	BCC SETSP1
	LDA #4
SETSP1	STA NPUL
	LDA #18
	BCC SETSP2
	LDA #6
SETSP2	STA TIMG+1
	RTS

.FILE A3
